home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pastutor.EXE / tutor06b.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-02  |  7KB  |  251 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor06b;
  9.  
  10. uses Memory, TutConst, Drivers, Objects, Views, Menus, App, MsgBox,
  11.   Editors, StdDlg;
  12.  
  13. type
  14.   TTutorApp = object(TApplication)
  15.     ClipboardWindow: PEditWindow;
  16.     constructor Init;
  17.     procedure DoAboutBox;
  18.     procedure HandleEvent(var Event: TEvent); virtual;
  19.     procedure InitMenuBar; virtual;
  20.     procedure InitStatusLine; virtual;
  21.     procedure LoadDesktop;
  22.     procedure NewWindow;
  23.     procedure OpenWindow;
  24.     procedure SaveDesktop;
  25.   end;
  26.  
  27. procedure TutorStreamError(var S: TStream); far;
  28. var
  29.   ErrorMessage: String;
  30. begin
  31.   case S.Status of
  32.     stError: ErrorMessage := 'Stream access error';
  33.     stInitError: ErrorMessage := 'Cannot initialize stream';
  34.     stReadError: ErrorMessage := 'Read beyond end of stream';
  35.     stWriteError: ErrorMessage := 'Cannot expand stream';
  36.     stGetError: ErrorMessage := 'Unregistered type read from stream';
  37.     stPutError: ErrorMessage := 'Unregistered type written to stream';
  38.     end;
  39.   DoneVideo;
  40.   PrintStr('Error: ' + ErrorMessage);
  41.   Halt(S.Status);
  42. end;
  43.  
  44. constructor TTutorApp.Init;
  45. var
  46.   R: TRect;
  47. begin
  48.   MaxHeapSize := 8192;
  49.   EditorDialog := StdEditorDialog;
  50.   StreamError := @TutorStreamError;
  51.   RegisterObjects;
  52.   RegisterViews;
  53.   RegisterApp;
  54.   RegisterEditors;
  55.   inherited Init;
  56.   DisableCommands([cmOrderWin, cmStockWin, cmSupplierWin]);
  57.   Desktop^.GetExtent(R);
  58.   ClipboardWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  59.   if ValidView(ClipboardWindow) <> nil then
  60.   begin
  61.     ClipboardWindow^.Hide;
  62.     InsertWindow(ClipboardWindow);
  63.     Clipboard := ClipboardWindow^.Editor;
  64.     Clipboard^.CanUndo := False;
  65.   end;
  66. end;
  67.  
  68. procedure TTutorApp.DoAboutBox;
  69. begin
  70.   MessageBox(#3'Turbo Vision Tutorial Application'#13 +
  71.     #3'Copyright 1992'#13#3'Borland International',
  72.     nil, mfInformation or mfOKButton);
  73. end;
  74.  
  75. procedure TTutorApp.HandleEvent(var Event: TEvent);
  76. var
  77.   R: TRect;
  78. begin
  79.   inherited HandleEvent(Event);
  80.   if Event.What = evCommand then
  81.   begin
  82.     case Event.Command of
  83.       cmOptionsLoad:
  84.         begin
  85.           LoadDesktop;
  86.           ClearEvent(Event);
  87.         end;
  88.       cmOptionsSave:
  89.         begin
  90.           SaveDesktop;
  91.           ClearEvent(Event);
  92.         end;
  93.       cmClipShow:
  94.         with ClipboardWindow^ do
  95.         begin
  96.           Select;
  97.           Show;
  98.           ClearEvent(Event);
  99.         end;
  100.       cmNew:
  101.         begin
  102.           NewWindow;
  103.           ClearEvent(Event);
  104.         end;
  105.       cmOpen:
  106.         begin
  107.           OpenWindow;
  108.           ClearEvent(Event);
  109.         end;
  110.       cmOptionsVideo:
  111.         begin
  112.           SetScreenMode(ScreenMode xor smFont8x8);
  113.           ClearEvent(Event);
  114.         end;
  115.       cmAbout:
  116.         begin
  117.           DoAboutBox;
  118.           ClearEvent(Event);
  119.         end;
  120.     end;
  121.   end;
  122. end;
  123.  
  124. procedure TTutorApp.InitMenuBar;
  125. var
  126.   R: TRect;
  127. begin
  128.   GetExtent(R);
  129.   R.B.Y := R.A.Y + 1;
  130.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  131.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  132.       StdFileMenuItems(nil)),
  133.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  134.       StdEditMenuItems(
  135.       NewLine(
  136.       NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
  137.       nil)))),
  138.     NewSubMenu('~O~rders', hcNoContext, NewMenu(
  139.       NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
  140.       NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
  141.       NewLine(
  142.       NewItem('Next', 'PgDn', kbPgDn, cmOrderNext, hcNoContext,
  143.       NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
  144.       nil)))))),
  145.     NewSubMenu('O~p~tions', hcNoContext, NewMenu(
  146.       NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
  147.       NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
  148.       NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
  149.       nil)))),
  150.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  151.       NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
  152.       NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
  153.       NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
  154.       NewLine(
  155.       StdWindowMenuItems(nil)))))),
  156.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  157.       NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
  158.       nil)),
  159.     nil))))))
  160.   )));
  161. end;
  162.  
  163. procedure TTutorApp.InitStatusLine;
  164. var
  165.   R: TRect;
  166. begin
  167.   GetExtent(R);
  168.   R.A.Y := R.B.Y - 1;
  169.   New(StatusLine, Init(R,
  170.     NewStatusDef(0, $EFFF,
  171.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  172.       NewStatusKey('~F4~ New', kbF4, cmNew,
  173.       NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  174.       StdStatusKeys(nil)))),
  175.     NewStatusDef($F000, $FFFF,
  176.       NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
  177.       NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
  178.       StdStatusKeys(nil))), nil))));
  179. end;
  180.  
  181. procedure TTutorApp.LoadDesktop;
  182. var
  183.   DesktopFile: TBufStream;
  184.   TempDesktop: PDesktop;
  185.   R: TRect;
  186. begin
  187.   DesktopFile.Init('DESKTOP.TUT', stOpenRead, 1024);
  188.   TempDesktop := PDesktop(DesktopFile.Get);
  189.   DesktopFile.Done;
  190.   if ValidView(TempDesktop) <> nil then
  191.   begin
  192.     Desktop^.Delete(ClipboardWindow);
  193.     Delete(Desktop);
  194.     Dispose(Desktop, Done);
  195.     Desktop := TempDesktop;
  196.     Insert(Desktop);
  197.     GetExtent(R);
  198.     R.Grow(0, -1);
  199.     Desktop^.Locate(R);
  200.     InsertWindow(ClipboardWindow);
  201.   end;
  202. end;
  203.  
  204. procedure TTutorApp.NewWindow;
  205. var
  206.   R: TRect;
  207.   TheWindow: PEditWindow;
  208. begin
  209.   R.Assign(0, 0, 60, 20);
  210.   TheWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  211.   InsertWindow(TheWindow);
  212. end;
  213.  
  214. procedure TTutorApp.OpenWindow;
  215. var
  216.   R: TRect;
  217.   FileDialog: PFileDialog;
  218.   TheFile: FNameStr;
  219. const
  220.   FDOptions: Word = fdOKButton or fdOpenButton;
  221. begin
  222.   TheFile := '*.*';
  223.   New(FileDialog, Init(TheFile, 'Open file', '~F~ile name',
  224.     FDOptions, 1));
  225.   if ExecuteDialog(FileDialog, @TheFile) <> cmCancel then
  226.   begin
  227.     R.Assign(0, 0, 75, 20);
  228.     InsertWindow(New(PEditWindow, Init(R, TheFile, wnNoNumber)));
  229.   end;
  230. end;
  231.  
  232. procedure TTutorApp.SaveDesktop;
  233. var
  234.   DesktopFile: TBufStream;
  235. begin
  236.   Desktop^.Delete(ClipboardWindow);
  237.   DesktopFile.Init('DESKTOP.TUT', stCreate, 1024);
  238.   DesktopFile.Put(Desktop);
  239.   DesktopFile.Done;
  240.   InsertWindow(ClipboardWindow);
  241. end;
  242.  
  243. var
  244.   TutorApp: TTutorApp;
  245.  
  246. begin
  247.   TutorApp.Init;
  248.   TutorApp.Run;
  249.   TutorApp.Done;
  250. end.
  251.